linalg_qr Module


Uses


Interfaces

public interface form_qr

  • private subroutine form_qr_no_pivot(r, tau, q, work, olwork, err)

    Forms the full M-by-M orthogonal matrix from the elementary reflectors returned by the base QR factorization algorithm.

    Arguments

    Type IntentOptional Attributes Name
    real(kind=real64), intent(inout), dimension(:,:) :: r

    On input, an M-by-N matrix where the elements below the diagonal contain the elementary reflectors generated from the QR factorization. On and above the diagonal, the matrix contains the matrix . On output, the elements below the diagonal are zeroed such that the remaining matrix is simply the M-by-N matrix .

    real(kind=real64), intent(in), dimension(:) :: tau

    A MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in .

    real(kind=real64), intent(out), dimension(:,:) :: q

    An M-by-M matrix where the full orthogonal matrix will be written. In the event that M > N, may be supplied as M-by-N, and therefore only return the useful submatrix as the factorization can be written as .

    real(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private subroutine form_qr_no_pivot_cmplx(r, tau, q, work, olwork, err)

    Forms the full M-by-M orthogonal matrix from the elementary reflectors returned by the base QR factorization algorithm.

    Arguments

    Type IntentOptional Attributes Name
    complex(kind=real64), intent(inout), dimension(:,:) :: r

    On input, an M-by-N matrix where the elements below the diagonal contain the elementary reflectors generated from the QR factorization. On and above the diagonal, the matrix contains the matrix . On output, the elements below the diagonal are zeroed such that the remaining matrix is simply the M-by-N matrix .

    complex(kind=real64), intent(in), dimension(:) :: tau

    A MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in .

    complex(kind=real64), intent(out), dimension(:,:) :: q

    An M-by-M matrix where the full orthogonal matrix will be written. In the event that M > N, may be supplied as M-by-N, and therefore only return the useful submatrix as the factorization can be written as .

    complex(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private subroutine form_qr_pivot(r, tau, pvt, q, p, work, olwork, err)

    Forms the full M-by-M orthogonal matrix from the elementary reflectors returned by the base QR factorization algorithm.

    Arguments

    Type IntentOptional Attributes Name
    real(kind=real64), intent(inout), dimension(:,:) :: r

    On input, an M-by-N matrix where the elements below the diagonal contain the elementary reflectors generated from the QR factorization. On and above the diagonal, the matrix contains the matrix . On output, the elements below the diagonal are zeroed such that the remaining matrix is simply the M-by-N matrix .

    real(kind=real64), intent(in), dimension(:) :: tau

    A MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in .

    integer(kind=int32), intent(in), dimension(:) :: pvt

    An N-element column pivot array as returned by the QR factorization.

    real(kind=real64), intent(out), dimension(:,:) :: q

    An M-by-M matrix where the full orthogonal matrix will be written. In the event that M > N, may be supplied as M-by-N, and therefore only return the useful submatrix as the factorization can be written as .

    real(kind=real64), intent(out), dimension(:,:) :: p

    An N-by-N matrix where the pivot matrix will be written.

    real(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private module subroutine form_qr_pivot_cmplx(r, tau, pvt, q, p, work, olwork, err)

    Forms the full M-by-M orthogonal matrix from the elementary reflectors returned by the base QR factorization algorithm.

    Arguments

    Type IntentOptional Attributes Name
    complex(kind=real64), intent(inout), dimension(:,:) :: r

    On input, an M-by-N matrix where the elements below the diagonal contain the elementary reflectors generated from the QR factorization. On and above the diagonal, the matrix contains the matrix . On output, the elements below the diagonal are zeroed such that the remaining matrix is simply the M-by-N matrix .

    complex(kind=real64), intent(in), dimension(:) :: tau

    A MIN(M, N)-element array containing the scalar factors of each elementary reflector defined in .

    integer(kind=int32), intent(in), dimension(:) :: pvt

    An N-element column pivot array as returned by the QR factorization.

    complex(kind=real64), intent(out), dimension(:,:) :: q

    An M-by-M matrix where the full orthogonal matrix will be written. In the event that M > N, may be supplied as M-by-N, and therefore only return the useful submatrix as the factorization can be written as .

    complex(kind=real64), intent(out), dimension(:,:) :: p

    An N-by-N matrix where the pivot matrix will be written.

    complex(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

public interface mult_qr

  • private subroutine mult_qr_mtx(lside, trans, a, tau, c, work, olwork, err)

    Multiplies a general matrix by the orthogonal matrix from a QR factorization such that or .

    Arguments

    Type IntentOptional Attributes Name
    logical, intent(in) :: lside

    Set to true to apply or from the left; else, set to false to apply or from the right.

    logical, intent(in) :: trans

    Set to true to apply ; else, set to false to apply .

    real(kind=real64), intent(inout), dimension(:,:) :: a

    On input, an LDA-by-K matrix containing the elementary reflectors output from the QR factorization. If lside is set to true, LDA = M, and M >= K >= 0; else, if lside is set to false, LDA = N, and N >= K >= 0. Notice, the contents of this matrix are restored on exit.

    real(kind=real64), intent(in), dimension(:) :: tau

    A K-element array containing the scalar factors of each elementary reflector defined in.

    real(kind=real64), intent(inout), dimension(:,:) :: c

    On input, the M-by-N matrix . On output, the product of the orthogonal matrix and the original matrix .

    real(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private subroutine mult_qr_mtx_cmplx(lside, trans, a, tau, c, work, olwork, err)

    Multiplies a general matrix by the orthogonal matrix from a QR factorization such that or .

    Arguments

    Type IntentOptional Attributes Name
    logical, intent(in) :: lside

    Set to true to apply or from the left; else, set to false to apply or from the right.

    logical, intent(in) :: trans

    Set to true to apply ; else, set to false to apply .

    complex(kind=real64), intent(inout), dimension(:,:) :: a

    On input, an LDA-by-K matrix containing the elementary reflectors output from the QR factorization. If lside is set to true, LDA = M, and M >= K >= 0; else, if lside is set to false, LDA = N, and N >= K >= 0. Notice, the contents of this matrix are restored on exit.

    complex(kind=real64), intent(in), dimension(:) :: tau

    A K-element array containing the scalar factors of each elementary reflector defined in.

    complex(kind=real64), intent(inout), dimension(:,:) :: c

    On input, the M-by-N matrix . On output, the product of the orthogonal matrix and the original matrix .

    complex(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private subroutine mult_qr_vec(trans, a, tau, c, work, olwork, err)

    Multiplies a vector by the orthogonal matrix from a QR factorization such that .

    Arguments

    Type IntentOptional Attributes Name
    logical, intent(in) :: trans

    Set to true to apply ; else, set to false to apply .

    real(kind=real64), intent(inout), dimension(:,:) :: a

    On input, an M-by-K matrix containing the elementary reflectors output from the QR factorization. Notice, the contents of this matrix are restored on exit.

    real(kind=real64), intent(in), dimension(:) :: tau

    A K-element array containing the scalar factors of each elementary reflector defined in.

    real(kind=real64), intent(inout), dimension(:) :: c

    On input, the M-element vector . On output, the product of the orthogonal matrix and the original vector .

    real(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private subroutine mult_qr_vec_cmplx(trans, a, tau, c, work, olwork, err)

    Multiplies a vector by the orthogonal matrix from a QR factorization such that .

    Arguments

    Type IntentOptional Attributes Name
    logical, intent(in) :: trans

    Set to true to apply ; else, set to false to apply .

    complex(kind=real64), intent(inout), dimension(:,:) :: a

    On input, an M-by-K matrix containing the elementary reflectors output from the QR factorization. Notice, the contents of this matrix are restored on exit.

    complex(kind=real64), intent(in), dimension(:) :: tau

    A K-element array containing the scalar factors of each elementary reflector defined in.

    complex(kind=real64), intent(inout), dimension(:) :: c

    On input, the M-element vector . On output, the product of the orthogonal matrix and the original vector .

    complex(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

public interface qr_factor

  • private subroutine qr_factor_no_pivot(a, tau, work, olwork, err)

    Computes the QR factorization of an M-by-N matrix.

    Arguments

    Type IntentOptional Attributes Name
    real(kind=real64), intent(inout), dimension(:,:) :: a

    On input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.

    real(kind=real64), intent(out), dimension(:) :: tau

    A MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.

    real(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private subroutine qr_factor_no_pivot_cmplx(a, tau, work, olwork, err)

    Computes the QR factorization of an M-by-N matrix.

    Arguments

    Type IntentOptional Attributes Name
    complex(kind=real64), intent(inout), dimension(:,:) :: a

    On input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.

    complex(kind=real64), intent(out), dimension(:) :: tau

    A MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.

    complex(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private subroutine qr_factor_pivot(a, tau, jpvt, work, olwork, err)

    Computes the QR factorization of an M-by-N matrix using column pivoting such that .

    Arguments

    Type IntentOptional Attributes Name
    real(kind=real64), intent(inout), dimension(:,:) :: a

    On input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.

    real(kind=real64), intent(out), dimension(:) :: tau

    A MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.

    integer(kind=int32), intent(inout), dimension(:) :: jpvt

    On input, an N-element array that if JPVT(I) .ne. 0, the I-th column of A is permuted to the front of A * P; if JPVT(I) = 0, the I-th column of A is a free column. On output, if JPVT(I) = K, then the I-th column of A * P was the K-th column of A.

    real(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private subroutine qr_factor_pivot_cmplx(a, tau, jpvt, work, olwork, rwork, err)

    Computes the QR factorization of an M-by-N matrix using column pivoting such that .

    Arguments

    Type IntentOptional Attributes Name
    complex(kind=real64), intent(inout), dimension(:,:) :: a

    On input, the M-by-N matrix to factor. On output, the elements on and above the diagonal contain the MIN(M, N)-by-N upper trapezoidal matrix R (R is upper triangular if M >= N). The elements below the diagonal, along with the array tau, represent the orthogonal matrix Q as a product of elementary reflectors.

    complex(kind=real64), intent(out), dimension(:) :: tau

    A MIN(M, N)-element array used to store the scalar factors of the elementary reflectors.

    integer(kind=int32), intent(inout), dimension(:) :: jpvt

    On input, an N-element array that if JPVT(I) .ne. 0, the I-th column of A is permuted to the front of A * P; if JPVT(I) = 0, the I-th column of A is a free column. On output, if JPVT(I) = K, then the I-th column of A * P was the K-th column of A.

    complex(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    real(kind=real64), intent(out), optional, target, dimension(:) :: rwork

    An optional input, that if provided, prevents any local allocate of real-valued memory. If not provided, the memory required is allocated within. If provided, the length of the array must be at least 2*N.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

public interface qr_rank1_update

  • private subroutine qr_rank1_update_dbl(q, r, u, v, work, err)

    Computes the rank-1 update to an M-by-N QR factored matrix where , , and such that .

    Arguments

    Type IntentOptional Attributes Name
    real(kind=real64), intent(inout), dimension(:,:) :: q

    On input, the original M-by-K orthogonal matrix . On output, the updated matrix .

    real(kind=real64), intent(inout), dimension(:,:) :: r

    On input, the M-by-N matrix . On output, the updated matrix .

    real(kind=real64), intent(inout), dimension(:) :: u

    On input, the M-element update vector. On output, the original content of the array is overwritten.

    real(kind=real64), intent(inout), dimension(:) :: v

    On input, the N-element update vector. On output, the original content of the array is overwritten.

    real(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional argument that if supplied prevents local memory allocation. If provided, the array must have at least K elements.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private module subroutine qr_rank1_update_cmplx(q, r, u, v, work, rwork, err)

    Computes the rank-1 update to an M-by-N QR factored matrix where , , and such that .

    Arguments

    Type IntentOptional Attributes Name
    complex(kind=real64), intent(inout), dimension(:,:) :: q

    On input, the original M-by-K orthogonal matrix . On output, the updated matrix .

    complex(kind=real64), intent(inout), dimension(:,:) :: r

    On input, the M-by-N matrix . On output, the updated matrix .

    complex(kind=real64), intent(inout), dimension(:) :: u

    On input, the M-element update vector. On output, the original content of the array is overwritten.

    complex(kind=real64), intent(inout), dimension(:) :: v

    On input, the N-element update vector. On output, the original content of the array is overwritten.

    complex(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional argument that if supplied prevents local memory allocation. If provided, the array must have at least K elements.

    real(kind=real64), intent(out), optional, target, dimension(:) :: rwork

    An optional argument that if supplied prevents local memory allocation. If provided, the array must have at least K elements.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

public interface solve_qr

  • private subroutine solve_qr_no_pivot_mtx(a, tau, b, work, olwork, err)

    Solves a system of M QR-factored equations of N unknowns. M must be greater than or equal to N.

    Arguments

    Type IntentOptional Attributes Name
    real(kind=real64), intent(inout), dimension(:,:) :: a

    On input, the M-by-N QR factored matrix as returned by qr_factor.
    On output, the contents of this matrix are restored. Notice, M must be greater than or equal to N.

    real(kind=real64), intent(in), dimension(:) :: tau

    A MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.

    real(kind=real64), intent(inout), dimension(:,:) :: b

    On input, the M-by-NRHS right-hand-side matrix. On output, the first N rows are overwritten by the solution matrix.

    real(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private subroutine solve_qr_no_pivot_mtx_cmplx(a, tau, b, work, olwork, err)

    Solves a system of M QR-factored equations of N unknowns. M must be greater than or equal to N.

    Arguments

    Type IntentOptional Attributes Name
    complex(kind=real64), intent(inout), dimension(:,:) :: a

    On input, the M-by-N QR factored matrix as returned by qr_factor.
    On output, the contents of this matrix are restored. Notice, M must be greater than or equal to N.

    complex(kind=real64), intent(in), dimension(:) :: tau

    A MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.

    complex(kind=real64), intent(inout), dimension(:,:) :: b

    On input, the M-by-NRHS right-hand-side matrix. On output, the first N rows are overwritten by the solution matrix.

    complex(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private subroutine solve_qr_no_pivot_vec(a, tau, b, work, olwork, err)

    Solves a system of M QR-factored equations of N unknowns. M must be greater than or equal to N.

    Arguments

    Type IntentOptional Attributes Name
    real(kind=real64), intent(inout), dimension(:,:) :: a

    On input, the M-by-N QR factored matrix as returned by qr_factor.
    On output, the contents of this matrix are restored. Notice, M must be greater than or equal to N.

    real(kind=real64), intent(in), dimension(:) :: tau

    A MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.

    real(kind=real64), intent(inout), dimension(:) :: b

    On input, the M-element right-hand-side vector. On output, the first N elements are overwritten with the solution vector.

    real(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private module subroutine solve_qr_no_pivot_vec_cmplx(a, tau, b, work, olwork, err)

    Solves a system of M QR-factored equations of N unknowns. M must be greater than or equal to N.

    Arguments

    Type IntentOptional Attributes Name
    complex(kind=real64), intent(inout), dimension(:,:) :: a

    On input, the M-by-N QR factored matrix as returned by qr_factor.
    On output, the contents of this matrix are restored. Notice, M must be greater than or equal to N.

    complex(kind=real64), intent(in), dimension(:) :: tau

    A MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.

    complex(kind=real64), intent(inout), dimension(:) :: b

    On input, the M-element right-hand-side vector. On output, the first N elements are overwritten with the solution vector.

    complex(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private subroutine solve_qr_pivot_mtx(a, tau, jpvt, b, work, olwork, err)

    Solves a system of M QR-factored equations of N unknowns.

    Arguments

    Type IntentOptional Attributes Name
    real(kind=real64), intent(inout), dimension(:,:) :: a

    On input, the M-by-N QR factored matrix as returned by qr_factor.
    On output, the contents of this matrix are restored.

    real(kind=real64), intent(in), dimension(:) :: tau

    A MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.

    integer(kind=int32), intent(in), dimension(:) :: jpvt

    An N-element array, as output by qr_factor, used to track the column pivots.

    real(kind=real64), intent(inout), dimension(:,:) :: b

    On input, the MAX(M, N)-by-NRHS right-hand-side matrix. On output, the first N rows are overwritten by the solution matrix.

    real(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private subroutine solve_qr_pivot_mtx_cmplx(a, tau, jpvt, b, work, olwork, err)

    Solves a system of M QR-factored equations of N unknowns.

    Arguments

    Type IntentOptional Attributes Name
    complex(kind=real64), intent(inout), dimension(:,:) :: a

    On input, the M-by-N QR factored matrix as returned by qr_factor.
    On output, the contents of this matrix are restored.

    complex(kind=real64), intent(in), dimension(:) :: tau

    A MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.

    integer(kind=int32), intent(in), dimension(:) :: jpvt

    An N-element array, as output by qr_factor, used to track the column pivots.

    complex(kind=real64), intent(inout), dimension(:,:) :: b

    On input, the MAX(M, N)-by-NRHS right-hand-side matrix. On output, the first N rows are overwritten by the solution matrix.

    complex(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private module subroutine solve_qr_pivot_vec(a, tau, jpvt, b, work, olwork, err)

    Solves a system of M QR-factored equations of N unknowns.

    Arguments

    Type IntentOptional Attributes Name
    real(kind=real64), intent(inout), dimension(:,:) :: a

    On input, the M-by-N QR factored matrix as returned by qr_factor.
    On output, the contents of this matrix are restored.

    real(kind=real64), intent(in), dimension(:) :: tau

    A MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.

    integer(kind=int32), intent(in), dimension(:) :: jpvt

    An N-element array, as output by qr_factor, used to track the column pivots.

    real(kind=real64), intent(inout), dimension(:) :: b

    On input, the MAX(M, N)-by-NRHS right-hand-side vector. On output, the first N rows are overwritten by the solution vector.

    real(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.

  • private module subroutine solve_qr_pivot_vec_cmplx(a, tau, jpvt, b, work, olwork, err)

    Solves a system of M QR-factored equations of N unknowns.

    Arguments

    Type IntentOptional Attributes Name
    complex(kind=real64), intent(inout), dimension(:,:) :: a

    On input, the M-by-N QR factored matrix as returned by qr_factor.
    On output, the contents of this matrix are restored.

    complex(kind=real64), intent(in), dimension(:) :: tau

    A MIN(M, N)-element array containing the scalar factors of the elementary reflectors as returned by qr_factor.

    integer(kind=int32), intent(in), dimension(:) :: jpvt

    An N-element array, as output by qr_factor, used to track the column pivots.

    complex(kind=real64), intent(inout), dimension(:) :: b

    On input, the MAX(M, N)-by-NRHS right-hand-side vector. On output, the first N rows are overwritten by the solution vector.

    complex(kind=real64), intent(out), optional, target, dimension(:) :: work

    An optional input, that if provided, prevents any local memory allocation. If not provided, the memory required is allocated within. If provided, the length of the array must be at least olwork.

    integer(kind=int32), intent(out), optional :: olwork

    An optional output used to determine workspace size. If supplied, the routine determines the optimal size for work, and returns without performing any actual calculations.

    class(errors), intent(inout), optional, target :: err

    The error object to be updated.